home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "JMScreenSubs"
- Option Explicit
- '
- ' Scructure Definitions
- Type RECT
- Left As Long
- Top As Long
- Right As Long
- Bottom As Long
- End Type
- Type APPBARDATA
- cbSize As Long
- hWnd As Long
- uCallbackMessage As Long
- uEdge As Long
- rc As RECT
- lParam As Long
- End Type
- '
- ' Definitions
- Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
- Global Const ABS_ALWAYSONTOP = &H2
- Global Const ABS_AUTOHIDE = &H1
- Global Const ABM_GETSTATE = &H4
- Global Const ABM_GETTASKBARPOS = &H5
-
- Public Function JMTaskbarExists() As Integer
- Dim wrkBar As APPBARDATA
- On Error Resume Next
- '
- ' Set Size of Structure
- wrkBar.cbSize = 36
- '
- ' Get Status of Taskbar
- Select Case SHAppBarMessage(ABM_GETSTATE, wrkBar)
- Case ABS_ALWAYSONTOP, ABS_AUTOHIDE
- '
- ' Taskbar exists
- JMTaskbarExists = True
- Exit Function
- End Select
- '
- ' Taskbar does not
- JMTaskbarExists = False
- End Function
-
-
- Public Function JMScreenHeight() As Long
- Dim wrkBar As APPBARDATA
- Dim wrkHeight As Long
- Dim wrkTop As Long
- Dim wrkBottom As Long
- On Error GoTo JMScreenHeightError
- '
- ' Set Default Height
- JMScreenHeight = Screen.Height
- ' JMScreenHeight = 480 * Screen.TwipsPerPixelY
- ' Exit Function
- '
- ' Test for a Taskbar
- If (JMTaskbarExists() = False) Then Exit Function
- '
- ' Set Size of Structure
- wrkBar.cbSize = 36
- '
- ' Get Size and Position of Taskbar
- wrkHeight = Screen.Height / Screen.TwipsPerPixelY
- If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
- '
- ' Extract Top and Bottom
- wrkTop = wrkBar.rc.Top
- wrkBottom = wrkBar.rc.Bottom
- '
- ' Set if Bar is Vertical
- If (wrkTop <= 0 And wrkBottom >= wrkHeight) Then
- wrkHeight = Screen.Height
- '
- ' Set if Bar is at Top
- ElseIf (wrkTop < 0) Then
- wrkHeight = (wrkHeight - wrkBottom) * Screen.TwipsPerPixelY
- '
- ' Set if Bar is at Bottom
- ElseIf (wrkBottom >= wrkHeight) Then
- wrkHeight = wrkTop * Screen.TwipsPerPixelY
- '
- ' Set if Anywhere Else (Shouldn't be!)
- Else
- wrkHeight = Screen.Height
- End If
- '
- ' Set Height
- JMScreenHeight = wrkHeight
- Exit Function
- '
- ' Error
- JMScreenHeightError:
- JMScreenHeight = Screen.Height
- Exit Function
- End Function
- Public Function JMScreenWidth() As Long
- Dim wrkBar As APPBARDATA
- Dim wrkWidth As Long
- Dim wrkLeft As Long
- Dim wrkRight As Long
- On Error GoTo JMScreenWidthError
- '
- ' Set Default Width
- JMScreenWidth = Screen.Width
- ' JMScreenWidth = 640 * Screen.TwipsPerPixelX
- ' Exit Function
- '
- ' Test for a Taskbar
- If (JMTaskbarExists() = False) Then Exit Function
- '
- ' Set Size of Structure
- wrkBar.cbSize = 36
- '
- ' Get Size and Position of Taskbar
- wrkWidth = Screen.Width / Screen.TwipsPerPixelX
- If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
- '
- ' Extract Left and Right
- wrkLeft = wrkBar.rc.Left
- wrkRight = wrkBar.rc.Right
- '
- ' Set if Bar is Horizontal
- If (wrkLeft <= 0 And wrkRight >= wrkWidth) Then
- wrkWidth = Screen.Width
- '
- ' Set if Bar is at Left
- ElseIf (wrkLeft < 0) Then
- wrkWidth = (wrkWidth - wrkRight) * Screen.TwipsPerPixelX
- '
- ' Set if Bar is at Right
- ElseIf (wrkRight >= wrkWidth) Then
- wrkWidth = wrkLeft * Screen.TwipsPerPixelY
- '
- ' Set if Anywhere Else (Shouldn't be!)
- Else
- wrkWidth = Screen.Width
- End If
- '
- ' Set Width
- JMScreenWidth = wrkWidth
- Exit Function
- '
- ' Error
- JMScreenWidthError:
- JMScreenWidth = Screen.Width
- Exit Function
- End Function
-
- Public Function JMScreenTop() As Long
- Dim wrkBar As APPBARDATA
- Dim wrkScreenTop As Long
- Dim wrkHeight As Long
- Dim wrkTop As Long
- Dim wrkBottom As Long
- On Error GoTo JMScreenTopError
- '
- ' Set Default Top
- JMScreenTop = 0
- '
- ' Test for a Taskbar
- If (JMTaskbarExists() = False) Then Exit Function
- '
- ' Set Size of Structure
- wrkBar.cbSize = 36
- '
- ' Get Size and Position of Taskbar
- If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
- '
- ' Extract Top and Bottom
- wrkTop = wrkBar.rc.Top
- wrkBottom = wrkBar.rc.Bottom
- '
- ' Set Screen Height
- wrkHeight = Screen.Height / Screen.TwipsPerPixelY
- '
- ' Set if Bar is at Top
- If (wrkTop < 0 And wrkBottom < wrkHeight) Then
- wrkScreenTop = wrkBottom * Screen.TwipsPerPixelY
- '
- ' Set if Anywhere Else
- Else
- wrkScreenTop = 0
- End If
- '
- ' Set Top
- JMScreenTop = wrkScreenTop
- Exit Function
- '
- ' Error
- JMScreenTopError:
- JMScreenTop = 0
- Exit Function
- End Function
-
- Public Function JMScreenLeft() As Long
- Dim wrkBar As APPBARDATA
- Dim wrkScreenLeft As Long
- Dim wrkWidth As Long
- Dim wrkLeft As Long
- Dim wrkRight As Long
- On Error GoTo JMScreenLeftError
- '
- ' Set Default Top
- JMScreenLeft = 0
- '
- ' Test for a Taskbar
- If (JMTaskbarExists() = False) Then Exit Function
- '
- ' Set Size of Structure
- wrkBar.cbSize = 36
- '
- ' Get Size and Position of Taskbar
- If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
- '
- ' Extract Left and Right
- wrkLeft = wrkBar.rc.Left
- wrkRight = wrkBar.rc.Right
- '
- ' Set Screen Height
- wrkWidth = Screen.Width / Screen.TwipsPerPixelX
- '
- ' Set if Bar is at Left
- If (wrkLeft < 0 And wrkRight < wrkWidth) Then
- wrkScreenLeft = wrkRight * Screen.TwipsPerPixelX
- '
- ' Set if Anywhere Else
- Else
- wrkScreenLeft = 0
- End If
- '
- ' Set Left
- JMScreenLeft = wrkScreenLeft
- Exit Function
- '
- ' Error
- JMScreenLeftError:
- JMScreenLeft = 0
- Exit Function
- End Function
-
- Public Sub SetFormPosition(frmSetup As Form, argTop As Long, argLeft As Long)
- On Error Resume Next
- '
- ' Position Form
- frmSetup.Left = argLeft
- frmSetup.Top = argTop
- '
- ' Check not too far right
- If ((frmSetup.Left + frmSetup.Width) > (JMScreenLeft() + JMScreenWidth())) Then
- frmSetup.Left = JMScreenLeft() + JMScreenWidth() - frmSetup.Width
- End If
- '
- ' Check not too far down
- If ((frmSetup.Top + frmSetup.Height) > (JMScreenTop() + JMScreenHeight())) Then
- frmSetup.Top = JMScreenTop() + JMScreenHeight() - frmSetup.Height
- End If
- '
- ' Check not too far left
- If (frmSetup.Left < JMScreenLeft()) Then frmSetup.Left = JMScreenLeft()
- '
- ' Check not too far up
- If (frmSetup.Top < JMScreenTop()) Then frmSetup.Top = JMScreenTop()
- End Sub
-
-